home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / MINIQUAD.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  5.7 KB  |  209 lines
  1. 10  'MINIQUAD - Coil Shortened Quad Antenna - 13 NOV 94 rev. 29 SEP 96
  2. 20  COMMON U,UH,EX$,PROG$
  3. 30  IF EX$=""THEN EX$="EXIT"
  4. 40  PROG$="miniquad"
  5. 50  CLS:KEY OFF
  6. 60  COLOR 7,0,1
  7. 70  PI=3.14159
  8. 80  UL$=STRING$(80,205)
  9. 90  U1$="##.##"
  10. 100  U2$="###.###"
  11. 110  U3$="##.#"
  12. 120  '
  13. 130  '.....AWG calculator
  14. 140  DIM GA(40)      'AWG gauge
  15. 150  K=(0.46/0.005)^(1/39)     'increment multiplier
  16. 160  FOR Z=1 TO 40
  17. 170  N=Z+3
  18. 180  GA(Z)=0.46/K^N
  19. 190  NEXT Z
  20. 200  '
  21. 210  '.....start
  22. 220  CLS
  23. 230  COLOR 15,2
  24. 240  PRINT " MINIQUAD - Coil Shortened Quad Antenna";
  25. 250  PRINT TAB(52);"by Kris Merschrod KA2OIG/TI2 ";
  26. 260  PRINT STRING$(80,32);
  27. 270  LOCATE CSRLIN-1,20:PRINT "edited for HAMCALC by George Murphy VE3ERP"
  28. 280  COLOR 1,0:PRINT STRING$(80,223);
  29. 290  COLOR 7,0
  30. 300  '
  31. 310  '.....print diagram
  32. 320  T=59:COLOR 0,7
  33. 330  PRINT "        DIRECTOR       ";  TAB(T);"     REFLECTOR        ";
  34. 340  PRINT "   VARPTRORORORORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDORORORORCOLOR ";  TAB(T);"VARPTRORORORORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDORORORORCOLOR   ";
  35. 350  PRINT "   CALL L1           L2 CALL ";  TAB(T);"CALL L5           L6 CALL   ";
  36. 360  PRINT "   CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUND W SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL ";  TAB(T);"CALLDEFSNGSOUNDSOUNDSOUNDSOUND 1.05W SOUNDSOUNDSOUNDSOUNDDEFDBLCALL   ";
  37. 370  PRINT "   CALL                 CALL ";  TAB(T);"CALL                 CALL   ";
  38. 380  PRINT "   CALL                 H ";  TAB(T);"CALL               1.05H ";
  39. 390  PRINT "   CALL                 CALL ";  TAB(T);"CALL                 CALL   ";
  40. 400  PRINT "   CALL                 CALL ";  TAB(T);"CALL                 CALL   ";
  41. 410  PRINT "   CLSORORORORSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDOROROROR' ";  TAB(T);"CLSORORORORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDOROROROR'   ";
  42. 420  PRINT "     L3           L4   ";  TAB(T);"  L7           L8     ";
  43. 430  COLOR 7,0
  44. 440  FOR X=4 TO 13
  45. 450  LOCATE X,26:PRINT STRING$(30,32)
  46. 460  NEXT X
  47. 470  LOCATE 14:PRINT UL$;
  48. 480  '
  49. 490  GOSUB 1900  'preface
  50. 500  PRINT UL$;
  51. 510  COLOR 0,7:LOCATE CSRLIN,22
  52. 520  PRINT " Press 1 to continue or 0 to EXIT....."
  53. 530  COLOR 7,0
  54. 540  Z$=INKEY$:IF Z$=""THEN 540
  55. 550  IF Z$="0"THEN CLS:RUN EX$
  56. 560  IF Z$="1"THEN 590
  57. 570  GOTO 330
  58. 580  '
  59. 590  '.....unit of measure
  60. 600  VIEW PRINT 15 TO 24:CLS:VIEW PRINT:LOCATE 15
  61. 610  PRINT " Press number in < > to choose standard units of measure:"
  62. 620  PRINT UL$;
  63. 630  PRINT "  < 1 >  Metric"
  64. 640  PRINT "  < 2 >  U.S.A./Imperial"
  65. 650  Z$=INKEY$
  66. 660  IF Z$="1"THEN UM=0.3048:UM$=" m.":M$="m":GOTO 690
  67. 670  IF Z$="2"THEN UM=1:UM$=" ft.":M$="'":GOTO 690
  68. 680  GOTO 650
  69. 690  VIEW PRINT 15 TO 24:CLS:VIEW PRINT:LOCATE 15
  70. 700  '
  71. 710  '.....data input
  72. 720  PRINT " Width of Quad (";UM$;")......w= ";:INPUT A:A=A/UM
  73. 730  COLOR 0,7
  74. 740  LOCATE 7,11:PRINT USING U1$;A*UM;:PRINT M$;"SOUND"
  75. 750  LOCATE 7,T+6:PRINT USING U1$;(A*1.05)*UM;:PRINT M$;"SOUND"
  76. 760  COLOR 7,0
  77. 770  GOSUB 1740
  78. 780  '
  79. 790  PRINT " Height of Quad (";UM$;").....H= ";:INPUT H:H=H/UM
  80. 800  TEST=A/(H+A)
  81. 810  IF TEST <=0.5 THEN 870
  82. 820  PRINT " Height cannot be less than length!"
  83. 830  PRINT " Press any key to continue....."
  84. 840  IF INKEY$=""THEN 840
  85. 850  GOTO 210
  86. 860  '
  87. 870  COLOR 0,7
  88. 880  LOCATE 9,19:PRINT USING U1$;H*UM;:PRINT M$
  89. 890  LOCATE 9,T+15:PRINT USING U1$;(H*1.05)*UM;:PRINT M$;" "
  90. 900  COLOR 7,0:GOSUB 1740
  91. 910  '
  92. 920  '.....element diameter
  93. 930  LN=CSRLIN
  94. 940  PRINT " Press letter in < > to describe size of conductor in sides of quad:"
  95. 950  PRINT UL$;
  96. 960  PRINT "  < a >  Diameter in millimetres"
  97. 970  PRINT "  < b >  Diameter in inches"
  98. 980  PRINT "  < c >  AWG#"
  99. 990  Z$=INKEY$
  100. 1000  IF Z$="a"OR Z$="A"THEN WS$="mm":GOTO 1040
  101. 1010  IF Z$="b"OR Z$="B"THEN WS$="inches":GOTO 1040
  102. 1020  IF Z$="c"OR Z$="C"THEN WS$="AWG#":GOTO 1040
  103. 1030  GOTO 990
  104. 1040  PRINT " ENTER: Conductor size (";WS$;") ";:INPUT Z
  105. 1050  IF WS$="mm"THEN DIA=Z/25.4
  106. 1060  IF WS$="inches"THEN DIA=Z
  107. 1070  IF WS$="AWG#"THEN AWG=Z:DIA=GA(Z)
  108. 1080  VIEW PRINT 15 TO 24:CLS:VIEW PRINT:LOCATE 15
  109. 1090  '
  110. 1100  '.....frequency
  111. 1110  INPUT "ENTER: Frequency in MHz ";F
  112. 1120  WL=300/F     'wavelength
  113. 1130  TEST2=1005/F
  114. 1140  IF TEST2>(A*2+H*2)THEN 1190
  115. 1150  PRINT " This loop is larger than necessary for";F;"MHz operation."
  116. 1160  PRINT " Press any key to begin again....."
  117. 1170  IF INKEY$=""THEN 1170
  118. 1180  GOTO 210
  119. 1190  GOSUB 1740
  120. 1200  '
  121. 1210  '.....calculate inductance
  122. 1220  A1=A
  123. 1230  B=A/2
  124. 1240  A=A+H
  125. 1250  F1=10^6/(68*PI^2*F^2)
  126. 1260  F2=LOG(24*((251/F)-B)/DIA)-1
  127. 1270  F3=((1-(F*B/251))^2)-1
  128. 1280  F4=(251/F)-B
  129. 1290  F5=LOG(((24*A/2)-B)/DIA)-1
  130. 1300  F6=(((F*A/2)-F*B)/251)^2-1
  131. 1310  F7=A/2-B
  132. 1320  LMH=F1*((F2*F3/F4)-(F5*F6/F7))
  133. 1330  '
  134. 1340  '.....screen display
  135. 1350  LOCATE 4,27:PRINT "ANTENNA:"
  136. 1360  LOCATE 5,28:PRINT "Frequency (MHz)....";USING U2$;F
  137. 1370  LOCATE 6,28:PRINT "Wavelength (metres)";USING U2$;WL
  138. 1380  IF AWG=0 THEN 1400
  139. 1390  LOCATE 7,28:PRINT "Conductor (AWG)...#";AWG
  140. 1400  M$="mm.":IF UM=1 THEN M$="in."
  141. 1410  Y=UM:IF UM<>1 THEN Y=1/25.4
  142. 1420  LOCATE 8,28:PRINT "Conductor dia.(";M$;")";USING U2$;DIA/Y
  143. 1430  LOCATE 10,27:PRINT "L1 - L8:"
  144. 1440  LOCATE 11,28:PRINT "Inductance (>H)....";USING U2$;LMH
  145. 1450  '.....notes
  146. 1460  S1=WL*0.12:S2=WL*0.15:S$="metres"            'element spacing
  147. 1470  IF UM=1 THEN S1=S1/0.3048:S2=S2/0.3048:S$="feet"
  148. 1480  LOCATE 15
  149. 1490  PRINT " Notes:"
  150. 1500  PRINT " THENTHENTHENTHENTHENTHEN"
  151. 1510  PRINT " 1.  Antenna can be fed directly with 50- or 75- coaxial cable."
  152. 1520  PRINT " 2.  The use of a Transmatch ('antenna tuner') is recommended."
  153. 1530  PRINT " 3.  Space director and reflector elements from ";USING"##.#";S1;
  154. 1540  PRINT " to ";USING "##.#";S2;:PRINT " ";S$;" apart."
  155. 1550  PRINT " 4.  Adjust element spacing for minimum SWR."
  156. 1560  PRINT " 5.  Prune vertical sides for minimum SWR.";
  157. 1570  PRINT " 6.  Do not alter the coils or prune horizontal sides."
  158. 1580  GOSUB 1960   'screen dump
  159. 1590  GOSUB 1740   'clear bottom of screen
  160. 1600  PRINT " Press number in <> to:"
  161. 1610  PRINT UL$;
  162. 1620  PRINT "  <1> Design coils for this quad"
  163. 1630  PRINT "  <2> Select commercial (B&W) coils for this quad"
  164. 1640  PRINT "  <3> Design another quad"
  165. 1650  PRINT
  166. 1660  PRINT "  <0) EXIT program"
  167. 1670  Z$=INKEY$
  168. 1680  IF Z$="1"THEN CLS:UH=LMH:CHAIN"coildsgn"
  169. 1690  IF Z$="2"THEN CLS:U=LMH:CHAIN"aircore"
  170. 1700  IF Z$="3"THEN 210
  171. 1710  IF Z$="0"THEN CLS:RUN EX$
  172. 1720  GOTO 1670
  173. 1730  '
  174. 1740  '.....clear screen
  175. 1750  VIEW PRINT 15 TO 24:CLS:VIEW PRINT:LOCATE 15
  176. 1760  RETURN
  177. 1770  '
  178. 1780  '.....preface
  179. 1790  TB=7
  180. 1800  PRINT TAB(TB);
  181. 1810  PRINT "Adapted from a program by D. Sander, CQ magazine, Dec.1981, p.44."
  182. 1820  PRINT
  183. 1830  PRINT TAB(TB);
  184. 1840  PRINT "See THE ARRL ANTENNA COMPENDIUM, Volume 2, page 90, for a detailed"
  185. 1850  PRINT TAB(TB);
  186. 1860  PRINT "description of this antenna by Kris Merschrod, KA2OIG/TI2."
  187. 1870  PRINT UL$;
  188. 1880  RETURN
  189. 1890  '
  190. 1900  '.....preface
  191. 1910  OPEN"I",1,"\data\docfiles\antenna.doc"
  192. 1920  IF EOF(1)THEN 1940
  193. 1930  INPUT#1,NOTE$:PRINT "   ";NOTE$:GOTO 1920
  194. 1940  CLOSE:RETURN
  195. 1950  '
  196. 1960  'HARDCOPY
  197. 1970  GOSUB 2080:LOCATE 25,2:COLOR 14,6
  198. 1980  PRINT " Press 1 to print screen, 2 to print screen & ";
  199. 1990  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  200. 2000  Z$=INKEY$:IF Z$="3"THEN GOSUB 2080:RETURN
  201. 2010  IF Z$="1"OR Z$="2"THEN GOSUB 2080:GOTO 2030
  202. 2020  GOTO 2000
  203. 2030  FOR QX=1 TO 24:FOR QY=1 TO 80
  204. 2040  LPRINT CHR$(SCREEN(QX,QY));
  205. 2050  NEXT QY:NEXT QX
  206. 2060  IF Z$="2"THEN LPRINT CHR$(12)
  207. 2070  GOTO 1970
  208. 2080  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  209.